home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / asol.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.1 KB  |  71 lines
  1.       subroutine asol
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine evaluates the adjoint circuit response by doing a
  5. c forward/backward substitution on the transpose of the coefficient
  6. c matrix.
  7. c
  8. c spice version 2g.6  sccsid=tabinf 3/15/83
  9.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  10.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  11.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  12.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  13.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  14.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  15.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  16.      7   irowno,jcolno,nttbr,nttar,lvntmp
  17. c spice version 2g.6  sccsid=cirdat 3/15/83
  18.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  19.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  20. c spice version 2g.6  sccsid=blank 3/15/83
  21.       common /blank/ value(200000)
  22.       integer nodplc(64)
  23.       complex cvalue(32)
  24.       equivalence (value(1),nodplc(1),cvalue(1))
  25. c
  26. c  forward substitution
  27. c
  28.       do 20 i=2,nstop
  29.       iord=nodplc(icswpf+i)
  30.       loc=i
  31.    10 loc=nodplc(irpt+loc)
  32.       if (nodplc(irowno+loc).ge.i) go to 15
  33.       j=nodplc(irowno+loc)
  34.       jord=nodplc(icswpf+j)
  35.       value(lvn+iord)=value(lvn+iord)-value(lvn+loc)*value(lvn+jord)
  36.       go to 10
  37.    15 jord=nodplc(irswpf+i)
  38.       locnn=indxx(jord,iord)
  39.       value(lvn+iord)=value(lvn+iord)/value(lvn+locnn)
  40.    20 continue
  41. c
  42. c  backward substitution
  43. c
  44.       i=nstop
  45.    30 i=i-1
  46.       if (i.le.1) go to 60
  47.       iord=nodplc(icswpf+i)
  48.       loc=i
  49.    35 loc=nodplc(irpt+loc)
  50.    40 if (nodplc(irowno+loc).ne.i) go to 35
  51.    50 loc=nodplc(irpt+loc)
  52.       if (loc.eq.0) go to 30
  53.       j=nodplc(irowno+loc)
  54.       jord=nodplc(icswpf+j)
  55.       value(lvn+iord)=value(lvn+iord)-value(lvn+loc)*value(lvn+jord)
  56.       go to 50
  57. c
  58. c     reorder solution vector
  59. c
  60.    60 do 70 i=1,nstop
  61.       j=nodplc(irswpr+i)
  62.       k=nodplc(icswpf+j)
  63.       value(lvntmp+i)=value(lvn+k)
  64.    70 continue
  65.       call copy8(value(lvntmp+1),value(lvn+1),nstop)
  66. c
  67. c  finished
  68. c
  69.       return
  70.       end
  71.